Developer CD Series 1998 January: Mac OS SDK/Dev.CD Jan 98 SDK2.toast/Development Kits (Disc 2)/ScriptX/Code Samples/tapemesr/source/tape.sx

Text File | 1996-05-21 | 15.5 KB | 462 lines | [TEXT/ttxt]

--<<<-
-- Filename:
--     tape.sx
--
-- Other Files Required:
--     interfac.sxl - defines accessory interface module (interfac.sx)
--
-- Purpose:
--     tape.sx defines the classes for the tape measure tool.
--
-- Specialized Classes:
--     Hook, TextDisplay, TapeMeasure
--
-- Instructions to User:
--     The Hook class is a draggable TwoDMultiPresenter which works together
--     with the TapeMeasure to realize the tape measure object. The Hook part
--     can be dragged around, with one end anchored at its homeSpace. The
--     xSetter and ySetter methods of the Hook are overridden to rubberband a
--     line from the Hook to its homeSpace, and notify the homeSpace when it
--     has moved. The TapeMeasure is a draggable GroupSpace which manages the
--     Hook and the TextDisplay.
--
-- Author:
--     Steve Mayer
--     Robert Lockstone : 12-15-95 : Convert to 1.5 and modularize

--*=============================================================================*
--* Use the interface module defined in AutoFinder.
--*=============================================================================*
global autofindDir := spawn (parentDir (parentDir theScriptDir)) "autofind"

--*=============================================================================*
--* Open the library which defines the Accessory Interface module used by
--* AutoFinder.
--*=============================================================================*
if ((getModule @AccessoryInterface) = false) do
   (
   open LibraryContainer dir:autofindDir     \
                         path:"interfac.sxl" \
                         mode:@readable
   )

--*=============================================================================*
--* Define the interface for these Tape Measure classes.  Make sure to use
--* the accessory interface here.
--*=============================================================================*
module TapeInterface
   uses AccessoryInterface with exports everything end

   exports Hook
   exports instance variables homeSpace, dc, hookLine, hookInterpolator, display

   exports TextDisplay
   exports instance variables textObject
   exports dimensionSetter

   exports TapeMeasure
   exports instance variables display, hook, foundHome
   exports formatValue, updateDisplay, updateScale
end

--*=============================================================================*
--* Define the implementation module.
--*=============================================================================*
module TapeImplementation
   uses ScriptX
   uses TapeInterface with exports everything end
end

in module TapeImplementation

class Hook (TwoDMultiPresenter, Dragger)
instance variables
    homeSpace
    dc
    hookLine
    hookInterpolator
    display
end

method init self {class Hook} #rest args \
                              #key hub: ->
   (
   apply nextMethod self args

   prepend hub self

   local center := new Point x:(hub.width / 2) y:(hub.height / 2)
   local l := new TwoDShape boundary:(new Line x2:-30 y2:-30) \
                             stroke:blackBrush
   translate l.transform center.x center.y
   prepend hub l
   self.hookLine := l

   --*==========================================================================*
   --* Create a DragController so I can be grabbed and dragged around.  Set
   --* wholeSpace to true to avoid having to reappend myself to this controller
   --* in the drop method.  There is a bug which prevents that reappending.
   --* Ideally, wholeSpace should be false.
   --*==========================================================================*
   self.dc := new DragController space:hub wholeSpace:true

   return self
   )

--*=============================================================================*
--* Grab method is called when the hook gets a MouseDownEvent.
--*=============================================================================*
method grab self {class Hook} grabPoint ->
   (
   local p  := self.presentedBy
   local pp := p.presentedBy

   self.homeSpace := p

   -- Remove self and line from home space.
   deleteOne p self
   deleteOne p self.hookLine

   -- Translate self and line by parent space's (x,y)
   translate self.transform p.x p.y
   translate self.hookLine.transform p.x p.y

   -- Add self and line to parent space.
   prepend pp self.hookLine
   prepend pp self

   --*==========================================================================*
   --* Find a DragController in the parent's space (there must be one because
   --* 'addToTitle' will create one if there isn't one there).  If the
   --* DragController's wholeSpace is false, then append myself to that
   --* DragController so the hook can be dragged independently of the hub.
   --*==========================================================================*
   local dc := chooseOne pp.controllers \
                  (
                  control xx ->
                     (
                     if (isAKindOf control DragController) then return true
                                                           else return false
                     )
                  ) undefined

   if (NOT dc.wholeSpace) do append dc self
   )

method xSetter self {class Hook} value ->
(
    nextMethod self value
    local b := self.hookLine.boundary
    if (self.homeSpace = self.presentedBy) then
    (
        b.x2 := value - 30
    ) else
    (
        b.x2 := value - self.homeSpace.x - 30
    )
    self.hookLine.changed := true
    updateDisplay self.homeSpace b
    return value
)

method ySetter self {class Hook} value ->
(
    nextMethod self value
    local b := self.hookLine.boundary
    if (self.homeSpace = self.presentedBy) then
    (
        b.y2 := value - 30
    ) else
    (
        b.y2 := value - self.homeSpace.y - 30
    )
    self.hookLine.changed := true
    updateDisplay self.homeSpace b
    return value
)

--*=============================================================================*
--* Drop method is called when the hook gets a MouseUpEvent.
--*=============================================================================*
method drop self {class Hook} dropPoint ->
(
    -- Delete self and line from the parent space.
    deleteOne self.presentedBy self.hookLine
    deleteOne self.presentedBy self

    -- Translate self and line back to home space coordinates.
    translate self.transform (- self.homeSpace.x) (- self.homeSpace.y)
    translate self.hookLine.transform (- self.homeSpace.x) (- self.homeSpace.y)

    -- Add self and line back to home space.
    prepend self.homeSpace self.hookLine
    prepend self.homeSpace self

    self.homeSpace.changed := true
)

-- Class TextDisplay is a draggable display for a text presenter. It
-- looks in the media table under "background" for the background bitmap.
class TextDisplay (Dragger, GroupSpace)
instance variables
    textObject
end

method init self {class TextDisplay} #rest args \
                                     #key media: ->
(
    apply nextMethod self args

    append self media[@background]

    -- Create text presenter for display.
    local t := new TextPresenter boundary:media[@background].boundary.bBox \
        target:("" as Text)
    setDefaultAttr t @alignment @center
    setDefaultAttr t @font (new PlatformFont macintoshName:"Palatino" \
                                             windowsName:"Times")
    setDefaultAttr t @size 14
    setDefaultAttr t @leading 16
    setDefaultAttr t @weight @heavy
    prepend self t
    self.textObject := t
    self.dimension  := 1
    return self
)

-- Method dimensionSetter sets the y offset based on 1 or 2 dimensions.
method dimensionSetter self {class TextDisplay} value ->
(
    if value = 1 then
        self.textObject.y := 14
    else
        self.textObject.y := 7
)

-- Method valueSetter sets the text of the text display.
method valueSetter self {class TextDisplay} value ->
(
    self.textObject.target := (value as Text)
)

-- Class TapeMeasure implements a draggable tool used to measure two
-- dimensional space in one or two dimensions. It uses an instance of
-- the hook class to provide a draggable end point for the tape.
class TapeMeasure (Dragger, GroupSpace)
instance variables
    display
    hook
    scale
    foundHome:false    -- True if we're really displayed
end

method init self {class TapeMeasure} #rest args                                 \
                                     #key media:                                \
                                          display:                              \
                                          fill:(new Brush color:(new RGBColor   \
                                                                     red:100    \
                                                                     green:200  \
                                                                     blue:200)) \
                                          stroke:blackBrush ->
(
    apply nextMethod self args

    self.display := display

    -- Default scale is 1 dimension, 1 pixel per pixel.
    self.scale := #(#("pixels", 1))

    return self
)

method afterInit self {class TapeMeasure}                                    \
       #rest args                                                            \
       #key media:                                                           \
            display:                                                         \
            fill:(new Brush color:(new RGBColor red:100 green:200 blue:200)) \
            stroke:blackBrush ->
(
    apply nextMethod self args

    prepend self media[@ring]
    prepend self media[@hub]

    local h := new Hook boundary:(media[@hook].boundary.bBox) hub:self
    prepend h media[@hook]
    self.hook := h
    updateDisplay self h.hookLine.boundary

    return self
)

-- Method updateScale updates the scale of the tape measure.
method updateScale self {class TapeMeasure} ->
(
    -- Get space's scale and update the display
    if ((self.presentedby <> undefined) and
        (isDefined getScale) and
        (canObjectDo self.presentedby getScale)) do
    (
        self.scale:= getScale self.presentedby
    )
    self.display.dimension := size self.scale
    updateDisplay self self.hook.hookLine.boundary
)

method formatValue self {class TapeMeasure} value ->
(
    local x := value as String
    local i := getKeyOne x "."[1]
    if (i <> empty) do
        deleteFromTo x (i + 2) (size x)
    return x
)

-- Method updateDisplay updates the current measurement readout.
method updateDisplay self {class TapeMeasure} aLine ->
(
    local displayString
    local deltaX := abs (aLine.x2 - aLine.x1)
    local deltaY := abs (aLine.y2 - aLine.y1)
    -- If measuring in 1 dimension, use the distance formula.
    if ((size self.scale) = 1) then
    (
        local distance := (sqrt ((deltaX * deltaX) + (deltaY * deltaY))) / self.scale[1][2]
        displayString := (formatValue self distance) + " " + \
            self.scale[1][1]
    )
    -- If measuring in 2 dimensions, use the delta x and y.
    else
    (
        deltaX := deltaX / self.scale[1][2]
        deltaY := deltaY / self.scale[2][2]
        displayString := (formatValue self deltaX) + " " + \
            self.scale[1][1] + "\r" + (formatValue self deltaY) + " " + \
            self.scale[2][1]
    )
    self.display.value := displayString
)

--*=============================================================================*
--* Adds a TapeMeasure to a running title.
--*=============================================================================*
method addToTitle self {class TapeMeasure} title #key pres:(undefined) ->
   (
   if (self.foundHome) do return  --Only display self in one place

   --*==========================================================================*
   --* If one isn't supplied, try to find a presenter which can perform the
   --* getScale method.
   --*==========================================================================*
   if (isDefined getScale) and (pres = undefined) do
      (
      for w in title.windows until pres <> undefined do
         (
         if (canObjectDo w getScale) then pres := w
         else
            (
            for p in w until pres <> undefined do
               (
               if (canObjectDo p getScale) do pres := p
               )
            )
         )
      )

   --*==========================================================================*
   --* See if 'currentScene' IV is available and use it if it is.  If all else
   --* fails, default to the topmost window of the title.  Scale will default
   --* to measuring in pixels.
   --*==========================================================================*
   if (pres = undefined)             and \
      (isDefined currentSceneGetter) and \
      (canObjectDo title currentSceneGetter) then
      (
      pres := title.currentScene
      )
   else
      (
      if (pres = undefined) do pres := title.windows[1]
      )

   --*==========================================================================*
   --* Actually add the tape measure display and the tape measure to the window.
   --*==========================================================================*
   prepend pres self.display
   prepend pres self
   updateScale self

   --*==========================================================================*
   --* Look for a DragController so the tape measure can be dragged around.
   --* If there isn't one, create one.
   --*==========================================================================*
   if (canObjectDo pres controllersGetter) do
      (
      local controls := pres.controllers
      local dc := chooseOne controls \
                     (
                     control xx ->
                        (
                        if (isAKindOf control DragController) then return true
                                                              else return false
                        )
                     ) undefined
      if (dc != empty) then
         (
         if (NOT dc.wholeSpace) do
            (
            --*=================================================================*
            --* See explanation for disabling and re-enabling the hook's
            --* DragController in the next comment.
            --*=================================================================*
            self.hook.dc.enabled := false
            append dc self.display
            append dc self
            self.hook.dc.enabled := true
            )
         )
      else
         (
         --*====================================================================*
         --* Ok, there isn't a DragController, so we create one.  Because of a
         --* bug, we have to disable the hook's DragController first and then
         --* re-enable it after appending the tape measure.  If we don't, then
         --* the Window's DragController will override the hook's DragController
         --* and we won't be able to drag the hook independently of the hub.
         --*====================================================================*
         self.hook.dc.enabled := false
         local newDC := new DragController space:pres
         append newDC self.display
         append newDC self
         self.hook.dc.enabled := true
         )

      self.foundHome := true
      )
   )

in module Scratch
(
--*=============================================================================*
--* Create a library container and save the modules.
--*=============================================================================*
local lc := new LibraryContainer dir:(parentDir theScriptDir) \
                                 path:"tape.sxl"              \
                                 name:"Tape Measure Classes"

lc.startupAction := (lc -> forEach lc \
                              (
                              aModule xx ->
                                 (
                                 load aModule
                                 )
                              ) undefined)

append lc (getModule @TapeInterface)
append lc (getModule @TapeImplementation)

close lc
)

"Compiled tape.sx"